// http://incubator.quasimondo.com/processing/superfast_blur.php

unit FastBlur;

interface

uses
  Windows,
  Math,
  Graphics;

procedure BoxBlur(img: TBitmap; radius: integer);

implementation

procedure BoxBlur(img: TBitmap; radius: integer);
type
    TIntegerArray = ARRAY[0..MaxInt div SizeOf(integer) - 1] OF  integer;
    PIntegerArray = ^TIntegerArray;
var
    w, h, wm, hm, wh, divi :integer;
    rsum, gsum, bsum, x, y, i, p, p1, p2, yp, yi, yw,a :integer;
    r, g, b : array of integer;
    vmin, vmax, dv : array of integer;
    pix, pax: PIntegerArray;

begin
    if radius<1 then Exit;
    w:=img.width;
    h:=img.height;
    wm:=w-1;
    hm:=h-1;
    wh:=w*h;
    divi:=radius+radius+1;
    SetLength(r, wh);
    SetLength(g, wh);
    SetLength(b, wh);
    SetLength(vmax, max(w,h));
    SetLength(vmin, max(w,h));
    SetLength(dv, 256*divi);
    //SetLength(pix, wh);

    for i:= 0 to 256-1 do begin
    dv[i]:=(i div divi);
    end;

    yw:=0;
    yi:=0;

    for y:=0 to h-1 do
    begin
        rsum:=0;
        gsum:=0;
        bsum:=0;
        pix := img.ScanLine[y];
        for i:=-radius to radius do
        begin
            p := pix^[min(wm,max(i,0))];
            rsum := rsum + (p and $ff0000)shr 16;
            gsum := gsum + (p and $00ff00)shr 8;
            bsum := bsum + (p and $0000ff);
        end;

        for x:=0 to w-1 do
        begin
            r[yi]:=dv[rsum];
            g[yi]:=dv[gsum];
            b[yi]:=dv[bsum];
            if y=0 then
            begin
                vmin[x]:=min(x+radius+1,wm);
                vmax[x]:=max(x-radius,0);
            end;
            p1:=pix^[yw+vmin[x]];
            p2:=pix^[yw+vmax[x]];
            rsum:=rsum+((p1 and $ff0000)-(p2 and $ff0000))shr 16;
            gsum:=gsum+((p1 and $00ff00)-(p2 and $00ff00))shr 8;
            bsum:=bsum+ (p1 and $0000ff)-(p2 and $0000ff);
            yi:=yi+1;
        end;

        yw:=yw+w;
    end;

    for x:=0 to w-1 do
    begin
        rsum:=0;   gsum:=0;   bsum:=0;
        yp:=-radius*w;
        for i:=-radius to radius do
        begin
            yi:=max(0,yp)+x;
            rsum:=rsum+r[yi];   gsum:=gsum+g[yi];   bsum:=bsum+b[yi];
            yp:=yp+w;
        end;
        yi:=x;
        for y:=0 to h-1 do
        begin
            //pix[yi]=0xff000000 or (dv[rsum]<<16) or (dv[gsum]<<8) or dv[bsum];
            if x=0 then
            begin
                vmin[y]:=min(y+radius+1,hm)*w;
                vmax[y]:=max(y-radius,0)*w;
            end;
            p1:=x+vmin[y];   p2:=x+vmax[y];
            rsum:=rsum+r[p1]-r[p2];
            gsum:=gsum+g[p1]-g[p2];
            bsum:=bsum+b[p1]-b[p2];
        end;
    end;
end;
end.
